home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / IO / Compress / Zlib / Extra.pm < prev   
Encoding:
Perl POD Document  |  2008-09-03  |  4.9 KB  |  199 lines

  1. package IO::Compress::Zlib::Extra;
  2.  
  3. require 5.004 ;
  4.  
  5. use strict ;
  6. use warnings;
  7. use bytes;
  8.  
  9. our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
  10.  
  11. $VERSION = '2.015';
  12.  
  13. use IO::Compress::Gzip::Constants 2.015 ;
  14.  
  15. sub ExtraFieldError
  16. {
  17.     return $_[0];
  18.     return "Error with ExtraField Parameter: $_[0]" ;
  19. }
  20.  
  21. sub validateExtraFieldPair
  22. {
  23.     my $pair = shift ;
  24.     my $strict = shift;
  25.     my $gzipMode = shift ;
  26.  
  27.     return ExtraFieldError("Not an array ref")
  28.         unless ref $pair &&  ref $pair eq 'ARRAY';
  29.  
  30.     return ExtraFieldError("SubField must have two parts")
  31.         unless @$pair == 2 ;
  32.  
  33.     return ExtraFieldError("SubField ID is a reference")
  34.         if ref $pair->[0] ;
  35.  
  36.     return ExtraFieldError("SubField Data is a reference")
  37.         if ref $pair->[1] ;
  38.  
  39.     # ID is exactly two chars   
  40.     return ExtraFieldError("SubField ID not two chars long")
  41.         unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ;
  42.  
  43.     # Check that the 2nd byte of the ID isn't 0    
  44.     return ExtraFieldError("SubField ID 2nd byte is 0x00")
  45.         if $strict && $gzipMode && substr($pair->[0], 1, 1) eq "\x00" ;
  46.  
  47.     return ExtraFieldError("SubField Data too long")
  48.         if length $pair->[1] > GZIP_FEXTRA_SUBFIELD_MAX_SIZE ;
  49.  
  50.  
  51.     return undef ;
  52. }
  53.  
  54. sub parseRawExtra
  55. {
  56.     my $data     = shift ;
  57.     my $extraRef = shift;
  58.     my $strict   = shift;
  59.     my $gzipMode = shift ;
  60.  
  61.     #my $lax = shift ;
  62.  
  63.     #return undef
  64.     #    if $lax ;
  65.  
  66.     my $XLEN = length $data ;
  67.  
  68.     return ExtraFieldError("Too Large")
  69.         if $XLEN > GZIP_FEXTRA_MAX_SIZE;
  70.  
  71.     my $offset = 0 ;
  72.     while ($offset < $XLEN) {
  73.  
  74.         return ExtraFieldError("Truncated in FEXTRA Body Section")
  75.             if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE  > $XLEN ;
  76.  
  77.         my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE);    
  78.         $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE;
  79.  
  80.         my $subLen =  unpack("v", substr($data, $offset,
  81.                                             GZIP_FEXTRA_SUBFIELD_LEN_SIZE));
  82.         $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ;
  83.  
  84.         return ExtraFieldError("Truncated in FEXTRA Body Section")
  85.             if $offset + $subLen > $XLEN ;
  86.  
  87.         my $bad = validateExtraFieldPair( [$id, 
  88.                                            substr($data, $offset, $subLen)], 
  89.                                            $strict, $gzipMode );
  90.         return $bad if $bad ;
  91.         push @$extraRef, [$id => substr($data, $offset, $subLen)]
  92.             if defined $extraRef;;
  93.  
  94.         $offset += $subLen ;
  95.     }
  96.  
  97.         
  98.     return undef ;
  99. }
  100.  
  101.  
  102. sub mkSubField
  103. {
  104.     my $id = shift ;
  105.     my $data = shift ;
  106.  
  107.     return $id . pack("v", length $data) . $data ;
  108. }
  109.  
  110. sub parseExtraField
  111. {
  112.     my $dataRef  = $_[0];
  113.     my $strict   = $_[1];
  114.     my $gzipMode = $_[2];
  115.     #my $lax     = @_ == 2 ? $_[1] : 1;
  116.  
  117.  
  118.     # ExtraField can be any of
  119.     #
  120.     #    -ExtraField => $data
  121.     #
  122.     #    -ExtraField => [$id1, $data1,
  123.     #                    $id2, $data2]
  124.     #                     ...
  125.     #                   ]
  126.     #
  127.     #    -ExtraField => [ [$id1 => $data1],
  128.     #                     [$id2 => $data2],
  129.     #                     ...
  130.     #                   ]
  131.     #
  132.     #    -ExtraField => { $id1 => $data1,
  133.     #                     $id2 => $data2,
  134.     #                     ...
  135.     #                   }
  136.     
  137.     if ( ! ref $dataRef ) {
  138.  
  139.         return undef
  140.             if ! $strict;
  141.  
  142.         return parseRawExtra($dataRef, undef, 1, $gzipMode);
  143.     }
  144.  
  145.     #my $data = $$dataRef;
  146.     my $data = $dataRef;
  147.     my $out = '' ;
  148.  
  149.     if (ref $data eq 'ARRAY') {    
  150.         if (ref $data->[0]) {
  151.  
  152.             foreach my $pair (@$data) {
  153.                 return ExtraFieldError("Not list of lists")
  154.                     unless ref $pair eq 'ARRAY' ;
  155.  
  156.                 my $bad = validateExtraFieldPair($pair, $strict, $gzipMode) ;
  157.                 return $bad if $bad ;
  158.  
  159.                 $out .= mkSubField(@$pair);
  160.             }   
  161.         }   
  162.         else {
  163.             return ExtraFieldError("Not even number of elements")
  164.                 unless @$data % 2  == 0;
  165.  
  166.             for (my $ix = 0; $ix <= length(@$data) -1 ; $ix += 2) {
  167.                 my $bad = validateExtraFieldPair([$data->[$ix],
  168.                                                   $data->[$ix+1]], 
  169.                                                  $strict, $gzipMode) ;
  170.                 return $bad if $bad ;
  171.  
  172.                 $out .= mkSubField($data->[$ix], $data->[$ix+1]);
  173.             }   
  174.         }
  175.     }   
  176.     elsif (ref $data eq 'HASH') {    
  177.         while (my ($id, $info) = each %$data) {
  178.             my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode);
  179.             return $bad if $bad ;
  180.  
  181.             $out .= mkSubField($id, $info);
  182.         }   
  183.     }   
  184.     else {
  185.         return ExtraFieldError("Not a scalar, array ref or hash ref") ;
  186.     }
  187.  
  188.     return ExtraFieldError("Too Large")
  189.         if length $out > GZIP_FEXTRA_MAX_SIZE;
  190.  
  191.     $_[0] = $out ;
  192.  
  193.     return undef;
  194. }
  195.  
  196. 1;
  197.  
  198. __END__
  199.